home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops source / PPC source / cg7 < prev    next >
Text File  |  1998-06-22  |  7KB  |  294 lines
  1.  
  2. :f EXECERR
  3.     ." attempt to EXECUTE a non-EXECUTEable word"
  4.     1 die
  5. ;f
  6.  
  7.  
  8. (* 
  9. This file is only loaded when we're target compiling - it includes
  10. the main interpretation/compilation loop for the native PPC image.
  11. *)
  12.  
  13.  
  14.  
  15. ¥                ================================
  16. ¥                        INTERPRETATION
  17. ¥                ================================
  18.  
  19. (*
  20. In our native code/STC system, interpreting a word is slightly non-trivial.
  21. We provide two types of execution.  EXECUTE simply JMPs to
  22. the given cfa.  This will work for many words, but not all.  For the
  23. general case we provide another execution word EX-GEN (execute general) 
  24. which compiles the word in a separate buffer, plants a
  25. jump at the end, then branches to the start.  The jump at the end
  26. goes to ChkOK which checks the stack before returning.  EX-GEN is
  27. slower than EXECUTE, but will execute anything.  For this reason
  28. it is called by INTERPRET.  But note, EX-GEN can't be called from an
  29. installed application, since it causes compilation to occur.
  30. *)
  31.  
  32.  
  33.  
  34. : (EX-GEN)  { xt opcode compN? ¥ svCDP svNewCDP svExBuff_offs svLeaf?
  35.                                  svMC svMD -- }
  36.  
  37.     CDP -> origCDP                ¥ in case of an error during (comp)
  38.     CDP -> svCDP  leaf? -> svLeaf?
  39.     exBuff exBuff_offs +  -> svNewCDP
  40.     svNewCDP -> CDP
  41.     :noname  drop
  42.     xt
  43.     compN? IF opcode (compN) ELSE (comp) THEN
  44.     
  45.     tempObj_framesize
  46.     0 -> tempObj_framesize
  47.     300 " ;" evaluate                ¥ need native PPC ;
  48.     -> tempObj_framesize            ¥ and can't be any temp objects!
  49.     
  50.     exBuff_offs -> svExBuff_offs    ¥ Save old ExBuf offset
  51.     CDP svNewCDP -                    ¥ length of compiled code
  52.     ++> exBuff_offs                    ¥ increment ExBuff_offset by this amount
  53.     svCDP -> CDP                    ¥ restore proper CDP
  54.     svLeaf? -> leaf?                ¥ and leaf? flag
  55.     0 -> origCDP                    ¥ CDP is "normal" again
  56.     modCode -> svMC  modData -> svMD
  57.     compmod
  58.     IF    modcode_comp_start half_displ_range +  -> modCode
  59.         moddata_comp_start half_displ_range +  -> modData
  60.     THEN
  61.  
  62.     ( :noname xt )  execute                ¥ execute compiled code
  63.  
  64.     svMC -> modCode  svMD -> modData    ¥ restore module base addr regs
  65.     svExBuff_offs -> exBuff_offs        ¥ and old exBuf offset
  66.     ?stack
  67. ;
  68.  
  69. : EX-GEN  ( xt -- )        0 false (ex-gen)  ;
  70.  
  71.  
  72. : EXN  ( xt n -- )  ¥ This is to EX-GEN what (COMPN) is to (COMP).  It
  73.                     ¥  has the additional parameter n which is action code for
  74.                     ¥  -> ++>  etc.
  75.  
  76.     true (ex-gen)  ;
  77.  
  78.  
  79. (*
  80. INTERPRET is the interpretation loop.  Words from the input stream are
  81. interpreted until the input is exhausted.
  82. *)
  83.  
  84. forward fNum?                ¥ handles a floating point number.
  85. :f fNum?    false  ;f        ¥ will be defined properly when FP loaded
  86.  
  87. : TRY_NUMBER
  88.     fNum?            ¥ first check for a floating number
  89.                     ¥ If it returns true, nothing more to do
  90.     NIF
  91.         number        ¥ not FP num - try for ordinary number.  Fails if not
  92.         state
  93.         IF            ¥ compiling - compile number as a literal.
  94.             postpone literal
  95.         THEN        ¥ if interpreting, nothing more to do
  96.     THEN
  97. ;
  98.  
  99.  
  100. :f INTERPRET
  101.     BEGIN            ¥ interpretation loop
  102.         ?stack
  103.         logVec
  104.         bl skip-src
  105.         >in @  src-len =  ?EXIT        ¥ out if source exhausted
  106.  
  107.         defined?
  108.         dup 0>
  109.         IF    ¥ it's immediate.  As the word may have just been
  110.             ¥ compiled, we call fix_caches first, to ensure we don't get stale
  111.             ¥ instructions in the icache.  We use EXECUTE rather than EX-GEN which
  112.             ¥ would have been a lot slower, and would block optimization of any code
  113.             ¥ being compiled (this might be an immediate word during compilation,
  114.             ¥ like IF).  But note, we must ensure immediate words can be directly
  115.             ¥ called!
  116.  
  117.             drop
  118. ¥            dup 2- 512  fix_caches
  119.             execute
  120.         ELSE
  121.             IF                    ¥ found - not immediate - but what is STATE ?
  122.                 state
  123.                 NIF                ¥ Interpretation.  We execute the word via
  124.                                 ¥  EX-GEN, since all words are possible here.
  125.                     ex-gen
  126.                 ELSE
  127.                     (comp)
  128.                 THEN
  129.             ELSE                ¥ word not found.  Check for a number.
  130.                 try_number        ¥ fails if no number
  131.             THEN
  132.         THEN
  133.     AGAIN
  134. ;f
  135.  
  136.  
  137. : INTRP1  ( -- ?? )        ¥ Interprets one word/number from the input stream.
  138.     defined?
  139.     IF        ex-gen
  140.     ELSE    number
  141.     THEN
  142. ;
  143.  
  144. : OK    & >  emit  ;
  145.  
  146. 0 valuex quitTest?
  147.  
  148. :f QUIT
  149.     0 -> state            ¥ i.e. postpone [
  150.     quitVec
  151.     BEGIN
  152.         ?DP  RP0 RP!
  153. ¥ quitTest? if dbgr then
  154.         state
  155.         IF        3 spaces
  156.         ELSE    OK
  157.         THEN
  158.         query
  159.         interpret
  160.     AGAIN
  161. ;f
  162.  
  163.  
  164. :f SETUP_CG
  165.     branchType >type: branch_instrn
  166.  
  167.     deep_classinit: cstk
  168.     deep_classinit: cstk2
  169.     deep_classinit: cstk2_orig
  170.     deep_classinit: cstk_temp
  171.     
  172.     deep_classinit: fcstk
  173.     deep_classinit: fcstk2
  174.  
  175.     deep_classinit: gprs
  176.     deep_classinit: fprs
  177.     deep_classinit: crs
  178.  
  179.     gprRef 10    init: GPRs
  180.     fprRef 13    init: FPRs
  181.     CRref   7     init: CRs
  182.  
  183.     gprRef 10    init: stored_GPRs
  184.     fprRef 10    init: stored_FPRs
  185.     
  186.     classinit: theOD
  187.     classinit: tmpOD
  188.     classinit: valOD
  189.     classinit: storedOD
  190.  
  191.     allocate_reserved_regs
  192.     
  193.     CDP -> last_colon_defn            ¥ used by (b&d)
  194.     classinit: const_data
  195.     new: eq_ranges                    ¥ see cg3
  196.     new: const_data  new: sv_const_data
  197. ;f
  198.  
  199.  
  200. ¥ Note: we make IMMEDIATE immediate, so we can put it at the start of
  201. ¥ a definition if we want to - aids readability if the defn is longish.
  202.  
  203. : IMMEDIATE
  204.     $ 40  latest  cset  ;            ppc_only
  205.  
  206. : IMMED
  207.     $ 40  latest  cset  ;            ppc_immediate
  208.  
  209.  
  210. ¥ USES_CTR is used like IMMEDIATE, and indicates that the defn just
  211. ¥  compiled uses the count register (which will disallow DO loops
  212. ¥  calling that defn from using the count reg as the loop counter).
  213. ¥  This is normally handled automatically, but for code definitions
  214. ¥  this word may be useful.
  215.  
  216. : USES_CTR
  217.     $ 40  latest name>  cset  ;        ppc_immediate
  218.  
  219.  
  220.  
  221. : DB
  222.     $ 81820008    code,        ¥    lwz       r12, $8(r2/TOC)
  223.     $ 818C0000    code,        ¥    lwz       r12, (r12)
  224.     $ 7D8903A6    code,        ¥    mtspr     CTR, r12
  225.     $ 7C6B1B78    code,        ¥    or        r11, r3, r3
  226.     $ 7D8802A6    code,        ¥    mfspr     r12, LR
  227.     $ 9591FFFC    code,        ¥    stwu      r12, $-4(r17/RP)
  228.     $ 4E800421    code,        ¥    bctrl     
  229.     $ 81910000    code,        ¥    lwz       r12, (r17/RP)
  230.     $ 3A310004    code,        ¥    addi      r17/RP, r17/RP, 4  $4
  231.     $ 7D8803A6    code,        ¥    mtspr     LR, r12
  232.     $ 7D635B78    code,        ¥    or        r3, r11, r11
  233.     
  234.     CDP -> backstop_CDP        ¥ it's confusing if loads get hoisted here
  235.  
  236. ;        ppc_immediate
  237.  
  238. : DBX
  239.     0 code,
  240. ;        ppc_immediate
  241.  
  242.  
  243. ¥ We also have to unresolve all SysCalls and mark all modules as
  244. ¥  absent at initial startup.  This allows us to not do it when
  245. ¥  we write out a PEF, so that we can continue running.
  246.  
  247. forward MOD?
  248. :f mod? false  ;f        ¥ dummy - the real defn is in Modules.
  249.  
  250.  
  251. : (UNRES)  { xt dummy ¥ modAddr -- }
  252.     xt 2- w@ $ BF01 =            ¥ is it a syscall or extern?
  253.     IF  nilP  xt 6 + @abs  !  EXIT  THEN
  254.     
  255.     xt mod? NIF  drop  EXIT  THEN
  256.  
  257.     >obj -> modAddr
  258.     nilH modAddr !
  259. ;
  260.  
  261.  
  262. : UNRESOLVE_EVERYTHING  { ¥ ^ST -- }
  263.  
  264.     ['] (unres) 0  trav        ¥ fix syscalls and modules
  265.     
  266. ¥ now we set all assigned segments to absent
  267.     max_segs 2
  268.     DO    i  8 *  segTable +  -> ^ST
  269.         ^ST @
  270.         IF            ¥ it's assigned - set its base addr to nil
  271.             nilP  ^ST 4+ !
  272.         THEN
  273.     LOOP
  274. ;
  275.  
  276.  
  277. : INIT1            ¥  our initial initialization word.
  278.     unresolve_everything
  279.     LB_cache  512  erase
  280.     instld? NIF  setup_cg  THEN
  281.     filinit
  282. ;
  283.  
  284.  
  285. :f RUN
  286.     init1
  287.     ['] clFiles    -> abortvec        ¥ can't interpret ' yet, so we set up
  288.                                 ¥  abortvec here at the start of execution
  289.     cr ." This is the initial PowerMops nucleus.  Type"
  290.     cr ." // ppc1.ld"
  291.     cr ." to continue building the full system." cr
  292.     QUIT
  293. ;f
  294.